CD Actual 9/CDACTUAL9.iso/share/Dos/VARIOS/pascal/DELPHI.SWG/0005_TPanel component that allows Drag-Drop.pas

Pascal/Delphi Source File | 1996-02-21 | 6.8 KB | 232 lines

unit DropPnl;

{ (C) 1995, ingenieursbureau Office Automation
  All Rights Reserved

  Hereby the right to distribute this work electronically is granted,
  provided such is done for at most a nominal fee. Also the right is
  granted to store this work on a computer system.
  Finally the right is granted to incorporate this work into other
  work provided no fee is asked for this work.
  In all cases of distribution this work must be distributed in full,
  which specifically includes this notice.
  Liability is limited to the amount payed for this work. Legal
  jurisdiction is with the court of Leeuwarden, the Netherlands.

  Roelof Osinga, 29 december 1995
}

interface

uses
  WinTypes, WinProcs, Messages, Classes, Controls, Forms, Graphics,
  StdCtrls, ExtCtrls, Buttons, ShellApi, SysUtils;

type
  TDropActions = (daSimple, daRecursive, daEventOnly);

  TDropEvent = procedure(Sender : TObject; FileList : TStringList; X, Y: Integer) of object;

  TDropPanel = class(TPanel)
  protected
    FDroppedList : TStringList;
    FDroppedPoint : TPoint;
    FDropAction : TDropActions;
    FAtRunTime : boolean;
    FOnDrop : TDropEvent;
    function HandleDroppedGlyphs(aGlyph : TBitmap; const aStr : string) : integer;
    procedure HandleDroppedBitBtnGlyphs(aComp : TBitBtn; const aStr : string);
    procedure HandleDroppedSpeedButtonGlyphs(aComp : TSpeedButton; const aStr : string);
    procedure HandleDroppedFiles;
    function HandleDroppedFilesRec(aComp : TWinControl; dropAt : TPoint) : boolean;
    procedure CreateParams(var Params : TCreateParams); override;
    procedure WMDropFiles(var Message : TMessage); message WM_DROPFILES;
    destructor Destroy; override;
  public
    constructor Create(anOwner : TComponent); override;
  published
    property DropAction : TDropActions read FDropAction write FDropAction default daRecursive;
    property AtRunTime : boolean read FAtRunTime write FAtRunTime default true;
    property OnDrop : TDropEvent read FOnDrop write FOnDrop;
  end;

procedure Register;

implementation

constructor TDropPanel.Create(anOwner : TComponent);
begin
  inherited Create(anOwner);
  FDroppedList := TStringList.Create;
  FDroppedPoint := Point(0,0);
  FDropAction := daRecursive;
  FAtRunTime := true;
end;

destructor TDropPanel.Destroy;
begin
  FDroppedList.Free;
  inherited Destroy;
end;

procedure TDropPanel.CreateParams(var Params : TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do
  begin
    ExStyle := ExStyle or WS_EX_ACCEPTFILES;
  end;
end;

function TDropPanel.HandleDroppedGlyphs(aGlyph : TBitmap; const aStr : string) : integer;
var Glyphs : integer;
begin
  Result := 1;
  try
    aGlyph.LoadFromFile(aStr);
    if (aGlyph.Width mod aGlyph.Height) = 0
    then begin
      Glyphs := aGlyph.Width div aGlyph.Height;
      if Glyphs > 4
      then Glyphs := 1;
      Result := Glyphs;
    end;
  except
    ;
  end;
end;

procedure TDropPanel.HandleDroppedBitBtnGlyphs(aComp : TBitBtn; const aStr : string);
begin
  aComp.NumGlyphs := HandleDroppedGlyphs(aComp.Glyph, aStr); {FDroppedList[0]);}
end;

procedure TDropPanel.HandleDroppedSpeedButtonGlyphs(aComp : TSpeedButton; const aStr : string);
begin
  aComp.NumGlyphs := HandleDroppedGlyphs(aComp.Glyph, aStr); {FDroppedList[0]);}
end;

procedure TDropPanel.HandleDroppedFiles;
var
  i, j, nL, nC : integer;
  comp : TComponent;
begin
  nL := FDroppedList.Count - 1;
  if nL > -1
  then begin
    nC := ControlCount - 1;
    for i := 0 to nC do
    begin
      comp := Controls[i];
      if PtInRect(TControl(comp).BoundsRect, FDroppedPoint)
      then begin
         if comp is TImage
         then (comp as TImage).Picture.LoadFromFile(FDroppedList[0]);
         if comp is TMemo
         then (comp as TMemo).Lines.LoadFromFile(FDroppedList[0]);
         if (comp is TBitBtn)
         then HandleDroppedBitBtnGlyphs(TBitBtn(comp), FDroppedList[0]);
         if (comp is TSpeedButton)
         then HandleDroppedSpeedButtonGlyphs(TSpeedButton(comp), FDroppedList[0]);
       end;
    end;
  end;
end;

function TDropPanel.HandleDroppedFilesRec(aComp : TWinControl; dropAt : TPoint) : boolean;
var
  i, nL, nC : integer;
  done : boolean;
  aControl : TComponent;
begin
  done := false;
  nL := FDroppedList.Count - 1;
  if nL > -1
  then begin
    nC := aComp.ControlCount - 1;
    i := -1;
    while not done and (i < nC) do
    begin
      inc(i);
      aControl := aComp.Controls[i];
      if PtInRect(TControl(aControl).BoundsRect, dropAt)
      then begin
         if not done and (aControl is TImage)
         then begin
           try
             (aControl as TImage).Picture.LoadFromFile(FDroppedList[0]);
           except ;
           end;
           done := true;
         end;
         if not done and (aControl is TMemo)
         then begin
           (aControl as TMemo).Lines.LoadFromFile(FDroppedList[0]);
           done := true;
         end;
         if not done and (aControl is TBitBtn)
         then begin
           HandleDroppedBitBtnGlyphs(TBitBtn(aControl), FDroppedList[0]);
           done := true;
         end;
         if not done and (aControl is TSpeedButton)
         then begin
           HandleDroppedSpeedButtonGlyphs(TSpeedButton(aControl), FDroppedList[0]);
           done := true;
         end;
         if not done and (aControl is TWinControl) and
           not ((aControl is TMemo) or (aControl is TBitBtn))
         then begin
           done := HandleDroppedFilesRec(TWinControl(aControl),
                     TWinControl(aControl).ScreenToClient(aComp.ClientToScreen(dropAt)) );
         end;
       end;
    end;
  end;
  if not done and (aComp = Self)
  then MessageBeep(0);
  Result := done;
end;

procedure TDropPanel.WMDropFiles(var Message : TMessage);
var
  hDrop : THandle;
  nFiles, i, size : word;
  Pstr : PChar;
begin
  hDrop := Message.WParam;
  Pstr := StrAlloc(256);
  Message.Result := 0; {accept}
  try
    DragQueryPoint(hDrop, FDroppedPoint);
    nFiles := DragQueryFile(hDrop, $FFFF, Pstr, size);
    dec(nFiles);
    FDroppedList.Clear;
    for i := 0 to nFiles do
    begin
      {size := DragQueryFile(hDrop, i, nil, size);}
      size := 255;
      size := DragQueryFile(hDrop, i, Pstr, size+1);
      FDroppedList.Add(StrPas(Pstr));
    end;
  finally
    DragFinish(hDrop);
    StrDispose(Pstr);
  end;
  if Assigned(FOnDrop)
  then FOnDrop(Self, FDroppedList, FDroppedPoint.X, FDroppedPoint.Y);
  if FAtRunTime or (csDesigning in ComponentState)
  then
    case FDropAction of
      daSimple : HandleDroppedFiles;
      daRecursive : HandleDroppedFilesRec(Self, FDroppedPoint);
    end;
end;

procedure Register;
begin
  RegisterComponents('IBOA', [TDropPanel]);
end;

end.